module SynchronizerTest(assertSuccess, assertSuccessUpdate, assertConflict, (@@), ($$), synchronizerTests) where
import DataUpdate
import Synchronizers
import Test.HUnit
import DataParser
import UpdateParser
import Debug.Trace
--import Control.Monad.Error
import qualified Data.Map as Map

instance Monad (Either a) where
    return = Right
    x >>= f = case x of
        Left l -> Left l 
        Right r -> f r

removeEither :: (Either a a)->a
removeEither (Left a) = a
removeEither (Right a) = a

fromRight :: (Either a b)->b
fromRight (Right a) = a
 
assertSync :: (Constraint c)=>(Maybe UpdateEnv-> Test)->c->String->String->Test
assertSync f synchronizer valuesStr updatesStr = removeEither $ 
    do
        values <- convertParseResult valuesStr $ parseString2ValEnv valuesStr
        updates <- convertParseResult updatesStr $ parseString2UpdateEnv updatesStr
        let result = sync synchronizer values updates
        return $ f result
        
convertParseResult :: String -> Either String a -> Either Test a
convertParseResult str (Left msg) = Left ((Test.HUnit.test.assertFailure) $ "cannot parse \"" ++ str ++ "\":" ++ msg)
convertParseResult str (Right u) = Right u
        

applyUpdates updates values = foldWithKey (\var u env -> env \\ (var, apply u (env#var))) values updates
assertSuccess :: (Constraint c)=>c->String->String->String->Test
assertSuccess synchronizer inputValues inputUpdates expectedValues = 
    assertSync assertResult synchronizer inputValues inputUpdates 
    where 
        assertResult (Just updates) = removeEither $ 
            do 
                values <- convertParseResult inputValues $ parseString2ValEnv inputValues
                expected <- convertParseResult expectedValues $ parseString2ValEnv expectedValues
                return $ expected ~=? (applyUpdates updates values)
        assertResult Nothing = TestCase (assertFailure ("The synchronization should not fail"))

assertSuccessUpdate synchronizer inputValues inputUpdates expectedUpdates = --assertResult result
    assertSync assertResult synchronizer inputValues inputUpdates 
    where 
        assertResult (Just updates) = removeEither $ 
            do 
               expected <- convertParseResult expectedUpdates $ parseString2UpdateEnv expectedUpdates
               return $ expected ~=? updates 
        assertResult Nothing = TestCase (assertFailure ("The synchronization should not fail"))

           
assertConflict synchronizer inputValues inputUpdates = --Nothing ~=? result
    assertSync (\r->Nothing ~=? r) synchronizer inputValues inputUpdates
    
assertCheckTrue synchronizer values = removeEither $
    do
        parsedValues <- convertParseResult values $ parseString2ValEnv values
        return $ True ~=? check synchronizer parsedValues


(@@) f str = f str
($$) f str = f str

aIsOneTwoThree = letc "v" (intConst 1) ("a" <=> "v") <|> letc "v" (intConst 2) ("a" <=> "v") <|> letc "v" (intConst 3) ("a" <=> "v")

rec a = letc "t0" (nullConst) (a <=> "t0") <|> ((letc "t1" (lete "t3" (stringConst "x") (a <.> "t3")) (letc "t2" (intConst 1) ("t1" <=> "t2"))) <&> letc "t4" (lete "t5" (stringConst "y") (a <.> "t5")) (DynCstraint (rec "t4")))

synchronizerTests = [
        assertSuccess (DynCstraint ("a" <=> "b")) @@ "{a->1, b->2}" $$ "{a->3, b->void}" @@ "{a->3, b->3}",                 
        assertSuccess (DynCstraint  $ "a" <=> "b") @@ "{a->1, b->2}" $$ "{a->void, b->void}" @@ "{a->2, b->2}",                 
        assertSuccess ("a" <=> "b") @@ "{a->1, b->2}" $$ "{b->3}" @@ "{a->3, b->3}",               
        assertSuccessUpdate ("a" <=> "b") @@ "{a->2, b->2}" $$ "{}" $$ "{}",
        assertConflict ("a" <=> "b") @@ "{a->1, b->2}" $$ "{a->3, b->4}",
        assertSuccess ("b" <=> "c" <&> "a" <=> "b") @@ "{a->2, b->2, c->2}" $$ "{a->4}" @@ "{a->4, b->4, c->4}",            
        assertSuccess (DynCstraint  $ "b" <=> "c" <&> "a" <=> "b") @@ "{a->1, b->2, c->3}" $$ "{}" @@ "{a->3, b->3, c->3}",
        "b=1, consistent" ~: assertSuccessUpdate (letc "a" (intConst 1) ("b" <=> "a")) @@ "{b=1}" $$ "{}" $$ "{}", 
        "b=1, inconsistent" ~: assertSuccess (letc "a" (intConst 1) ("b" <=> "a")) @@ "{b=2}" $$ "{}" @@ "{b=1}",
        "b=1, conflict" ~: assertConflict (letc "a" (intConst 1) ("b" <=> "a")) @@ "{b=2}" $$ "{b=3}",
        "v=d.k, change k" ~: assertSuccess (letc "v1" ("d" <.> "k") ("v" <=> "v1")) @@ "{d={1=a, 2=b}, k=1, v=a}" $$ "{k->2}" @@ "{d={1=a, 2=b}, k=2, v=b}",   
        "v=d.k, change d" ~: assertSuccess (letc "v1" ("d" <.> "k") ("v" <=> "v1")) @@ "{d={1=a, 2=b}, k=1, v=a}" $$ "{d->{1->c}}" @@ "{d={1=c, 2=b}, k=1, v=c}",   
        "v=d.k, change v" ~: assertSuccess (letc "v1" ("d" <.> "k") ("v" <=> "v1")) @@ "{d={1=a, 2=b}, k=1, v=a}" $$ "{v->c}" @@ "{d={1=c, 2=b}, k=1, v=c}",   
        "v=d.k, null k" ~: assertSuccess (letc "v1" ("d" <.> "k") ("v" <=> "v1")) @@ "{d={1=a, 2=b}, k=null, v=x}" $$ "{}" @@ "{d={1=a, 2=b}, k=3, v=null}",   
        "v=d.k, inconsistent" ~: assertSuccess (letc "v1" ("d" <.> "k") ("v" <=> "v1")) @@ "{d={1=a, 2=b}, k=1, v=x}" $$ "{}" @@ "{d={1=a, 2=b}, k=1, v=a}",
        "a=1 or a=2 or a=3, a=1" ~: assertSuccessUpdate aIsOneTwoThree @@ "{a=1}" $$ "{}" $$ "{}",
        "a=1 or a=2 or a=3, a=2" ~: assertSuccessUpdate aIsOneTwoThree @@ "{a=2}" $$ "{}" $$ "{}",
        "a=1 or a=2 or a=3, a=3" ~: assertSuccessUpdate aIsOneTwoThree @@ "{a=3}" $$ "{}" $$ "{}",
        "a=1 or a=2 or a=3, a=4" ~: assertSuccessUpdate aIsOneTwoThree @@ "{a=4}" $$ "{}" $$ "{a->1}",
        "a=1 or a=2 or a=3, a changes to 2" ~: assertSuccessUpdate aIsOneTwoThree @@ "{a=4}" $$ "{a->2}" $$ "{a->2}",
        "a=1 or a=2 or a=3, a changes to 4" ~: assertConflict aIsOneTwoThree @@ "{a=4}" $$ "{a->4}",
        "d->forall(v | v =a), consistent, a changes" ~: assertSuccess
            (forall "d" "v" ("v" <=> "a")) 
            @@ "{d={1=c, 2=c}, a=c}" $$ "{a->b}" @@ "{d={1=b, 2=b}, a=b}",
        "d->forall(v | v =a), consistent, d changes" ~: assertSuccess
            (forall "d" "v" ("v" <=> "a")) 
            @@ "{d={1=c, 2=c}, a=c}" $$ "{d->{2->b}}" @@ "{d={1=b, 2=b}, a=b}",
        "d->forall(v | v =a), inconsistent" ~: assertSuccess
            (forall "d" "v" ("v" <=> "a")) 
            @@ "{d={1=a, 2=c}, a=b}" $$ "{}" @@ "{d={1=b, 2=b}, a=b}",
        "d->forall(v | v =a and not (v = null)), deleting items" ~: assertSuccess
            (forall "d" "v" (("v" <=> "a") <&> notc (letc "v1" nullConst ("v" <=> "v1")))) 
            @@ "{d={1=b, 2=b}, a=b}" $$ "{d->{1->null}}" @@ "{d={2=b}, a=b}",
        "d->exists(v | v=a), consistent, d changes but does not affect a" ~: assertSuccess
            (exists "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{d->{1->c}}" @@ "{d->{1->c, 2->b}, a=b}",
        "d->exists(v | v=a), consistent, d changes" ~: assertSuccess
            (exists "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{d->{2->c}}" @@ "{d->{1->a, 2->c, 3->b}, a=b}",
        "d->exists(v | v=a), consistent, a changes" ~: assertSuccess
            (exists "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{a->c}" @@ "{d->{1->a, 2->b, 3->c}, a=c}",
        "d->exists!(v | v=a), consistent, d changes but does not affect a" ~: assertSuccess
            (exists' "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{d->{1->c}}" @@ "{d->{1->c, 2->b}, a=b}",
        "d->exists!(v | v=a), consistent, d changes" ~: assertSuccess
            (exists' "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{d->{2->c}}" @@ "{d->{1->a, 2->c}, a=c}",
        "d->exists'(v | v=a), consistent, a changes" ~: assertSuccess
            (exists' "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{a->c}" @@ "{d->{1->a, 2->c}, a=c}",
        "d->exists(v | v=a), consistent, deletion in d" ~: assertSuccess
            (exists "d" "v" ("v" <=> "a"))
            @@ "{d={1=a, 2=b}, a=b}" $$ "{d->{2->null}}" @@ "{d->{1->a, 3->b}, a=b}",
        "rec(a) := a = null or a.\"x\"=1 and rec(a.\"y\"), consistent with nothingg changes" ~: 
            assertSuccess (rec "a") @@ "{a->{x->1}}" $$ "{}" @@ "{a->{x->1}}",
        "rec(a) := a = null or a.\"x\"=1 and rec(a.\"y\"), consistent with nothingg changes, recusion required" ~: 
            (assertSuccess (rec "a") @@ "{a->{x->1, y->{x->1}}}" $$ "{}" @@ "{a->{x->1, y->{x->1}}}"),
        "rec(a) := a = null or a.\"x\"=1 and rec(a.\"y\"), check" ~:
            assertCheckTrue (rec "a") "{a->{x->1, y->{x->1}}}",
        "rec(a) := a = null or a.\"x\"=1 and rec(a.\"y\"), inconsistent with deletion disallowed" ~: 
            (assertSuccess (rec "a") @@ "{a->{x->1, y->{x->2}}}" $$ "{a->{y->{}}}" @@ "{a->{x->1, y->{x->1}}}")
            
    ]